home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
percnt.zip
/
TESTIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-11-07
|
8KB
|
242 lines
{$R Testit.RES}
program TestIt;
Uses CtlDLLImport, Strings, WinTypes, WinProcs, WObjectB;
const
ID_VERSION = 101;
ID_CTLTYPES = 102;
ID_TITLE = 103;
ID_CTLTYPESLIST = 104;
Tab = chr(9);
type
PInfoDialog = ^InfoDialog;
PTestItWindow = ^TestItWindow;
InfoDialog = object (TDialog)
Version ,
NoTypes ,
szTitle : PStatic;
TypeList: PListBox;
constructor Init(AParent: PWindowsObject;
AName : PChar);
destructor Done; virtual;
procedure SetupWindow; virtual;
end;
TestItApp = object (TApplication)
procedure InitMainWindow; virtual;
end;
TestItWindow = object (TDlgWindow)
PctCtrl : HWnd;
ExitBtn ,
FlagBtn ,
InfoBtn ,
DecPBtn ,
IncPBtn ,
StyleBtn: PButton;
destructor Done; virtual;
constructor Init(AParent: PWindowsObject;
AName : PChar);
procedure SetupWindow; virtual;
procedure ExitButton (var Msg: TMessage); virtual id_First + 103;
procedure FlagButton (var Msg: TMessage); virtual id_First + 101;
procedure InfoButton (var Msg: TMessage); virtual id_First + 100;
procedure DecPButton (var Msg: TMessage); virtual id_First + 105;
procedure IncPButton (var Msg: TMessage); virtual id_First + 104;
procedure StyleButton (var Msg: TMessage); virtual id_First + 102;
end;
var
hInfo ,
hStyle: THandle;
Test : TestItApp;
constructor InfoDialog.Init(AParent: PWindowsObject; AName: PChar);
begin { InfoDialog.Init }
TDialog.Init(AParent, AName);
Version := New(PStatic , InitResource(@self, ID_VERSION , 5));
NoTypes := New(PStatic , InitResource(@self, ID_CTLTYPES, 5));
szTitle := New(PStatic , InitResource(@self, ID_TITLE , ctlTitle));
TypeList := New(PListBox, InitResource(@self, ID_CTLTYPESLIST))
end { InfoDialog.Init };
destructor InfoDialog.Done;
begin { InfoDialog.Done }
dispose(Version , Done);
dispose(NoTypes , Done);
dispose(szTitle , Done);
dispose(TypeList, Done);
TDialog.Done
end { InfoDialog.Done };
procedure InfoDialog.SetupWindow;
var
i : integer;
Info: PCtlInfo;
s : string[80];
t : array [0 .. 10] of char;
p : array [0 .. 80] of char;
begin { InfoDialog.SetupWindow }
TDialog.SetupWindow;
Info := GlobalLock(hInfo);
Str(Info^.wVersion:1, s); StrPCopy(p, s);
Version^.SetText(p);
Str(Info^.wCtlTypes:1, s); StrPCopy(p, s);
NoTypes^.SetText(p);
szTitle^.SetText(Info^.szTitle);
for i := 0 to CtlTypes - 1 do
begin
Str(i:2, s);
StrPCopy(p, s);
StrCat(p, Tab);
Str(Info^.ctType[i].wWidth:1, s);
StrPCopy(t, s);
StrCat(p, t);
StrCat(p, Tab);
Str(Info^.ctType[i].wHeight:1, s);
StrPCopy(t, s);
StrCat(p, t);
StrCat(p, Tab);
Str(Info^.ctType[i].dwStyle:1, s);
StrPCopy(t, s);
StrCat(p, t);
TypeList^.AddString(p)
end;
GlobalUnlock(hInfo)
end { InfoDialog.SetupWindow };
procedure TestItApp.InitMainWindow;
begin { TestItApp.InitMainWindow }
MainWindow := New(PTestItWindow, Init(nil, 'TestIt'))
end { TestItApp.InitMainWindow };
destructor TestItWindow.Done;
begin { TestItWindow.Done }
dispose(ExitBtn , Done);
dispose(FlagBtn , Done);
dispose(InfoBtn , Done);
dispose(DecPBtn , Done);
dispose(IncPBtn , Done);
dispose(StyleBtn, Done);
DestroyWindow(PctCtrl);
GlobalFree(hInfo);
GlobalFree(hStyle);
TDlgWindow.Done
end { TestItWindow.Done };
constructor TestItWindow.Init(AParent: PWindowsObject;
AName : PChar);
var
Info : PCtlInfo;
Style: PCtlStyle;
begin { TestItWindow.Init }
TDlgWindow.Init(AParent, AName);
ExitBtn := New(PButton, InitResource(@Self, 103));
FlagBtn := New(PButton, InitResource(@Self, 101));
InfoBtn := New(PButton, InitResource(@Self, 100));
DecPBtn := New(PButton, InitResource(@Self, 105));
IncPBtn := New(PButton, InitResource(@Self, 104));
StyleBtn := New(PButton, InitResource(@Self, 102));
hInfo := PercentCtrlInfo;
hStyle := GlobalAlloc(gmem_Moveable, sizeof(TCtlStyle));
if hInfo <> 0
then
begin
Info := GlobalLock(hInfo);
if Info <> nil
then
if hStyle <> 0
then
begin
Style := GlobalLock(hStyle);
if Style <> nil
then
with Style^ do
begin
wX := 0;
wY := 0;
wCx := Info^.ctType[0].wWidth;
wCy := Info^.ctType[0].wHeight;
wId := 100;
dwStyle := Info^.ctType[0].dwStyle;
StrCopy(szClass, Info^.szClass);
StrCopy(szTitle, Info^.szTitle);
GlobalUnlock(hStyle)
end
end;
GlobalUnlock(hInfo)
end
end { TestItWindow.Init };
procedure TestItWindow.SetupWindow;
var
Rect: TRect;
begin { TestItWindow.SetupWindow }
TDlgWindow.SetupWindow;
GetClientRect(HWindow, Rect);
PctCtrl := GetItemHandle(106)
end { TestItWindow.SetupWindow };
procedure TestItWindow.ExitButton(var Msg: TMessage);
begin { TestItWindow.ExitButton }
SendMessage(HWindow, wm_Close, 0, 0)
end { TestItWindow.ExitButton };
procedure TestItWindow.FlagButton(var Msg: TMessage);
var
w: word;
p: PCtlStyle;
t: packed array [0 .. 256] of char;
begin { TestItWindow.FlagButton }
FillChar(t, sizeof(t), #0);
p := GlobalLock(hStyle);
w := PercentCtrlFlags(p^.dwStyle, t, 256);
MessageBox(HWindow, t, 'Control Flags', mb_OK)
end { TestItWindow.FlagButton };
procedure TestItWindow.InfoButton(var Msg: TMessage);
var
Info: PInfoDialog;
begin { TestItWindow.InfoButton }
Info := New(PInfoDialog, Init(@self, 'CtlInfo'));
if Info <> nil
then Application^.ExecDialog(Info)
end { TestItWindow.InfoButton };
procedure TestItWindow.DecPButton(var Msg: TMessage);
begin { TestItWindow.DecPButton }
SendMessage(PctCtrl, pcm_AddPercent, word(-10), 0)
end { TestItWindow.DecPButton };
procedure TestItWindow.IncPButton(var Msg: TMessage);
begin { TestItWindow.IncPButton }
SendMessage(PctCtrl, pcm_AddPercent, 10, 0)
end { TestItWindow.IncPButton };
procedure TestItWindow.StyleButton(var Msg: TMessage);
var
b: LongBool;
begin { TestItWindow.StyleButton }
b := FALSE;
if hStyle <> 0
then b := PercentCtrlStyle(HWindow, hStyle, nil, nil)
end { TestItWindow.StyleButton };
begin { Main }
Test.Init('TestIt');
Test.Run;
Test.Done
end { Main }.